home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1993…stman Always Clicks Twice / ADC Developer CD (1993-01) (''The Postman Always Clicks Twice'')_iso / Dev.CD 199301.iso / Development Platforms / LISP Related / LISP Goodies / matt's utils 8sept / sound-scrap.lisp < prev    next >
Encoding:
Text File  |  1992-08-15  |  3.0 KB  |  114 lines  |  [TEXT/CCL2]
  1. ;;;
  2. ;;; sound-scrap.lisp
  3. ;;;
  4.  
  5. #|
  6. ================================================================
  7. Purpose ========================================================
  8. ================================================================
  9. Created from Apple's Pict-Scrap.Lisp, defines a scrap-handler for scraps of
  10. type :|snd | .
  11.  
  12.  
  13. ================================================================
  14. Status =========================================================
  15. ================================================================
  16. Implemented.
  17.  
  18.  
  19. ================================================================
  20. Change history =================================================
  21. ================================================================
  22. 15-Aug-92 mc    Created.
  23.  
  24. |#
  25.  
  26.  
  27. (in-package "CCL")
  28.  
  29.  
  30. ;;;================================================================
  31. ;;; Define the sound-scrap-handler class and methods.
  32. ;;;================================================================
  33.  
  34. (defclass sound-scrap-handler (scrap-handler)
  35.   ()                                    ;no new slots
  36.   )
  37.  
  38.  
  39. (defmethod set-internal-scrap ((self sound-scrap-handler) scrap)
  40.   (declare (optimize speed))
  41.   ;;
  42.   (let* ((old-sound (slot-value self 'internal-scrap)))
  43.     (when (handlep old-sound)
  44.       ;(#_KillSound old-sound)          ;dispose of the old sound?
  45.       ))
  46.   (call-next-method self scrap)
  47.   (when scrap (pushnew :|snd | *scrap-state*)))
  48.  
  49.  
  50. (defmethod externalize-scrap ((sound-scrap-handler sound-scrap-handler))
  51.   (declare (optimize speed))
  52.   ;;
  53.   (let* ((the-sound (slot-value sound-scrap-handler 'internal-scrap))
  54.          (size (#_GetHandleSize the-sound)))
  55.     (when the-sound
  56.       (with-dereferenced-handles
  57.         ((the-sound the-sound))
  58.         (#_PutScrap size :|snd | the-sound)))))
  59.  
  60.  
  61. (defmethod internalize-scrap ((sound-scrap-handler sound-scrap-handler))
  62.   (declare (optimize speed))
  63.   ;;
  64.   (let* ((the-sound (#_NewHandle 0)))
  65.     (rlet ((junk :signed-long))
  66.       (#_GetScrap the-sound :|snd | junk))
  67.     (setf (slot-value sound-scrap-handler 'internal-scrap) the-sound)))
  68.  
  69.  
  70. (defmethod get-internal-scrap ((sound-scrap-handler sound-scrap-handler))
  71.   (declare (optimize speed))
  72.   ;;
  73.   (slot-value sound-scrap-handler 'internal-scrap))
  74.  
  75.  
  76. ;;; Done.
  77.  
  78. (pushnew `(:|snd | . ,(make-instance 'sound-scrap-handler))
  79.          *scrap-handler-alist*
  80.          :test #'equal)
  81.  
  82. (provide "SOUND-SCRAP")
  83.  
  84.  
  85.  
  86. #|
  87. ;;; Define sound-window, which supports pasting sounds.
  88. ;;;
  89. ;;; Because it doesn't remember the sounds it pastes it can't cut.
  90. ;;;
  91.  
  92. (defclass sound-window (window)
  93.   ()                                    ;no new slots
  94.   (:default-initargs 
  95.     :window-title "Sound Window"))
  96.  
  97.  
  98. (defmethod paste ((sound-window sound-window))
  99.   ;;
  100.   (let* ((h-sound (get-scrap :|snd |)))
  101.     (when h-sound
  102.       (#_HLock h-sound)
  103.       (#_LoadResource h-sound)
  104.       (let* ((int-play-error (#_SndPlay (%null-ptr) h-sound t)))        ;t = async
  105.         (#_HUnLock h-sound)
  106.         ;; Warn of error if failed.
  107.         (when (minusp int-play-error)
  108.           (warn "Error ~S playing ~S." int-play-error h-sound))))))
  109.  
  110.  
  111. (make-instance 'sound-window)
  112.  
  113. |#
  114.